home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / oberonv4 / oberon-src / nonfpu / opp.mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-11-22  |  33.7 KB  |  1,007 lines
  1. Syntax24b.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax10.Scn.Fnt
  5. (* Amiga NonFPU *) 
  6. MODULE OPP; (* NW, RC 6.3.89 / 18.10.92 *)
  7.  IMPORT
  8.   OPB, OPT, OPS, OPM, AmigaMathL;
  9.  CONST
  10.   (* numtyp values *)
  11.   char = 1; integer = 2; real = 3; longreal = 4;
  12.   (* symbol values *)
  13.   null = 0; times = 1; slash = 2; div = 3; mod = 4;
  14.   and = 5; plus = 6; minus = 7; or = 8; eql = 9;
  15.   neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
  16.   in = 15; is = 16; arrow = 17; period = 18; comma = 19;
  17.   colon = 20; upto = 21; rparen = 22; rbrak = 23; rbrace = 24;
  18.   of = 25; then = 26; do = 27; to = 28; by = 29;
  19.   lparen = 30; lbrak = 31; lbrace = 32; not = 33; becomes = 34;
  20.   number = 35; nil = 36; string = 37; ident = 38; semicolon = 39;
  21.   bar = 40; end = 41; else = 42; elsif = 43; until = 44;
  22.   if = 45; case = 46; while = 47; repeat = 48; for = 49;
  23.   loop = 50; with = 51; exit = 52; return = 53; array = 54;
  24.   record = 55; pointer = 56; begin = 57; const = 58; type = 59;
  25.   var = 60; procedure = 61; import = 62; module = 63; eof = 64;
  26.   (* object modes *)
  27.   Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
  28.   SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
  29.   (* Structure forms *)
  30.   Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  31.   Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  32.   Pointer = 13; ProcTyp = 14; Comp = 15;
  33.   intSet = {SInt..LInt};
  34.   (* composite structure forms *)
  35.   Basic = 1; Array = 2; DynArr = 3; Record = 4;
  36.   (*function number*)
  37.   haltfn = 0; newfn = 1; incfn = 13; sysnewfn = 30;
  38.   (* nodes classes *)
  39.   Nvar = 0; Nvarpar = 1; Nfield = 2; Nderef = 3; Nindex = 4; Nguard = 5; Neguard = 6;
  40.   Nconst = 7; Ntype = 8; Nproc = 9; Nupto = 10; Nmop = 11; Ndop = 12; Ncall = 13;
  41.   Ninittd = 14; Nif = 15; Ncaselse = 16; Ncasedo = 17; Nenter = 18; Nassign = 19;
  42.   Nifelse = 20; Ncase = 21; Nwhile = 22; Nrepeat = 23; Nloop = 24; Nexit = 25;
  43.   Nreturn = 26; Nwith = 27; Ntrap = 28;
  44.   (* node subclasses *)
  45.   super = 1;
  46.   (* module visibility of objects *)
  47.   internal = 0; external = 1; externalR = 2;
  48.   (* procedure flags (conval^.setval) *)
  49.   hasBody = 1; isRedef = 2; slNeeded = 3;
  50.  TYPE
  51.   CaseTable = ARRAY OPM.MaxCases OF
  52.    RECORD
  53.     low, high: LONGINT
  54.    END ;
  55.   sym, level: SHORTINT;
  56.   LoopLevel: INTEGER;
  57.   TDinit, lastTDinit: OPT.Node;
  58.   nofFwdPtr: INTEGER;
  59.   FwdPtr: ARRAY 64 OF OPT.Struct;
  60.  PROCEDURE^ Type(VAR typ, banned: OPT.Struct);
  61.  PROCEDURE^ Expression(VAR x: OPT.Node);
  62.  PROCEDURE^ Block(VAR procdec, statseq: OPT.Node);
  63.  PROCEDURE err(n: INTEGER);
  64.  BEGIN OPM.err(n)
  65.  END err;
  66.  PROCEDURE CheckSym(s: INTEGER);
  67.  BEGIN
  68.   IF sym = s THEN OPS.Get(sym) ELSE OPM.err(s) END
  69.  END CheckSym;
  70.  PROCEDURE qualident(VAR id: OPT.Object);
  71.   VAR obj: OPT.Object; lev: SHORTINT;
  72.  BEGIN (*sym = ident*)
  73.   OPT.Find(obj); OPS.Get(sym);
  74.   IF (sym = period) & (obj # NIL) & (obj^.mode = Mod) THEN
  75.    OPS.Get(sym);
  76.    IF sym = ident THEN
  77.     OPT.FindImport(obj, obj); OPS.Get(sym)
  78.    ELSE err(ident); obj := NIL
  79.    END
  80.   END ;
  81.   IF obj = NIL THEN err(0);
  82.    obj := OPT.NewObj(); obj^.mode := Var; obj^.typ := OPT.undftyp; obj^.adr := 0
  83.   ELSE lev := obj^.mnolev;
  84.    IF (obj^.mode IN {Var, VarPar}) & (lev # level) THEN
  85.     obj^.leaf := FALSE;
  86.     IF lev > 0 THEN OPB.StaticLink(level-lev) END
  87.    END
  88.   END ;
  89.   id := obj
  90.  END qualident;
  91.  PROCEDURE ConstExpression(VAR x: OPT.Node);
  92.  BEGIN Expression(x);
  93.   IF x^.class # Nconst THEN
  94.    err(50); x := OPB.NewIntConst(1) 
  95.   END
  96.  END ConstExpression;
  97.  PROCEDURE CheckMark(VAR vis: SHORTINT);
  98.  BEGIN OPS.Get(sym);
  99.   IF (sym = times) OR (sym = minus) THEN
  100.    IF level > 0 THEN err(47) END ;
  101.    IF sym = times THEN vis := external ELSE vis := externalR END ;
  102.    OPS.Get(sym)
  103.   ELSE vis := internal
  104.   END
  105.  END CheckMark;
  106.  PROCEDURE CheckSysFlag(VAR sysflag: INTEGER; default: INTEGER);
  107.   VAR x: OPT.Node; sf: LONGINT;
  108.  BEGIN
  109.   IF sym = lbrak THEN OPS.Get(sym); ConstExpression(x);
  110.    IF x^.typ^.form IN intSet THEN sf := x^.conval^.intval;
  111.     IF (sf < 0) OR (sf > OPM.MaxSysFlag) THEN err(220); sf := 0 END
  112.    ELSE err(51); sf := 0
  113.    END ;
  114.    sysflag := SHORT(sf); CheckSym(rbrak)
  115.   ELSE sysflag := default
  116.   END
  117.  END CheckSysFlag;
  118.  PROCEDURE RecordType(VAR typ, banned: OPT.Struct);
  119.   VAR fld, first, last, base: OPT.Object;
  120.    ftyp: OPT.Struct; sysflag: INTEGER;
  121.  BEGIN typ := OPT.NewStr(Comp, Record); typ^.BaseTyp := NIL;
  122.   CheckSysFlag(sysflag, -1);
  123.   IF sym = lparen THEN
  124.    OPS.Get(sym); (*record extension*)
  125.    IF sym = ident THEN
  126.     qualident(base);
  127.     IF (base^.mode = Typ) & (base^.typ^.comp = Record) THEN
  128.      IF base^.typ = banned THEN err(58)
  129.      ELSE typ^.BaseTyp := base^.typ; typ^.extlev := base^.typ^.extlev + 1; typ^.sysflag := base^.typ^.sysflag
  130.      END
  131.     ELSE err(52)
  132.     END
  133.    ELSE err(ident)
  134.    END ;
  135.    CheckSym(rparen)
  136.   END ;
  137.   IF sysflag >= 0 THEN typ^.sysflag := sysflag END ;
  138.   OPT.OpenScope(0, NIL); first := NIL; last := NIL;
  139.   LOOP
  140.    IF sym = ident THEN
  141.     LOOP
  142.      IF sym = ident THEN
  143.       IF typ^.BaseTyp # NIL THEN
  144.        OPT.FindField(OPS.name, typ^.BaseTyp, fld);
  145.        IF fld # NIL THEN err(1) END
  146.       END ;
  147.       OPT.Insert(OPS.name, fld); CheckMark(fld^.vis);
  148.       fld^.mode := Fld; fld^.link := NIL;
  149.       IF first = NIL THEN first := fld END ;
  150.       IF last = NIL THEN typ^.link := fld ELSE last^.link := fld END ;
  151.       last := fld
  152.      ELSE err(ident)
  153.      END ;
  154.      IF sym = comma THEN OPS.Get(sym)
  155.      ELSIF sym = ident THEN err(comma)
  156.      ELSE EXIT
  157.      END
  158.     END ;
  159.     CheckSym(colon); Type(ftyp, banned);
  160.     IF ftyp^.comp = DynArr THEN ftyp := OPT.undftyp; err(88) END ;
  161.     WHILE first # NIL DO
  162.      first^.typ := ftyp; first := first^.link
  163.     END
  164.    END ;
  165.    IF sym = semicolon THEN OPS.Get(sym)
  166.    ELSIF sym = ident THEN err(semicolon)
  167.    ELSE EXIT
  168.    END
  169.   END ;
  170.   OPT.CloseScope
  171.  END RecordType;
  172.  PROCEDURE ArrayType(VAR typ, banned: OPT.Struct);
  173.   VAR x: OPT.Node; n: LONGINT; sysflag: INTEGER;
  174.  BEGIN CheckSysFlag(sysflag, 0);
  175.   IF sym = of THEN (*dynamic array*)
  176.    typ := OPT.NewStr(Comp, DynArr); typ^.mno := 0; typ^.sysflag := sysflag;
  177.    OPS.Get(sym); Type(typ^.BaseTyp, banned);
  178.    IF typ^.BaseTyp^.comp = DynArr THEN typ^.n := typ^.BaseTyp^.n + 1
  179.    ELSE typ^.n := 0
  180.    END
  181.   ELSE
  182.    typ := OPT.NewStr(Comp, Array); typ^.sysflag := sysflag; ConstExpression(x);
  183.    IF x^.typ^.form IN intSet THEN n := x^.conval^.intval;
  184.     IF (n <= 0) OR (n > OPM.MaxIndex) THEN err(63); n := 1 END
  185.    ELSE err(51); n := 1
  186.    END ;
  187.    typ^.n := n;
  188.    IF sym = of THEN
  189.     OPS.Get(sym); Type(typ^.BaseTyp, banned)
  190.    ELSIF sym = comma THEN
  191.     OPS.Get(sym); IF sym # of THEN ArrayType(typ^.BaseTyp, banned) END
  192.    ELSE err(35)
  193.    END ;
  194.    IF typ^.BaseTyp^.comp = DynArr THEN typ^.BaseTyp := OPT.undftyp; err(88) END
  195.   END
  196.  END ArrayType;
  197.  PROCEDURE PointerType(VAR typ: OPT.Struct);
  198.   VAR id: OPT.Object;
  199.  BEGIN typ := OPT.NewStr(Pointer, Basic); CheckSysFlag(typ^.sysflag, 0);
  200.   CheckSym(to);
  201.   IF sym = ident THEN OPT.Find(id);
  202.    IF id = NIL THEN
  203.     IF nofFwdPtr < LEN(FwdPtr) THEN FwdPtr[nofFwdPtr] := typ; INC(nofFwdPtr)
  204.     ELSE err(224)
  205.     END ;
  206.     typ^.link := OPT.NewObj(); COPY(OPS.name, typ^.link^.name);
  207.     typ^.BaseTyp := OPT.undftyp; OPS.Get(sym) (*forward ref*)
  208.    ELSE qualident(id);
  209.     IF id^.mode = Typ THEN
  210.      IF id^.typ^.comp IN {Array, DynArr, Record} THEN
  211.       typ^.BaseTyp := id^.typ
  212.      ELSE typ^.BaseTyp := OPT.undftyp; err(57)
  213.      END
  214.     ELSE typ^.BaseTyp := OPT.undftyp; err(52)
  215.     END
  216.    END
  217.   ELSE Type(typ^.BaseTyp, OPT.notyp);
  218.    IF ~(typ^.BaseTyp^.comp IN {Array, DynArr, Record}) THEN
  219.     typ^.BaseTyp := OPT.undftyp; err(57)
  220.    END
  221.   END
  222.  END PointerType;
  223.  PROCEDURE FormalParameters(VAR firstPar: OPT.Object; VAR resTyp: OPT.Struct);
  224.   VAR mode: SHORTINT;
  225.     par, first, last, res: OPT.Object; typ: OPT.Struct;
  226.  BEGIN first := NIL; last := firstPar;
  227.   IF (sym = ident) OR (sym = var) THEN
  228.    LOOP
  229.     IF sym = var THEN OPS.Get(sym); mode := VarPar ELSE mode := Var END ;
  230.     LOOP
  231.      IF sym = ident THEN
  232.       OPT.Insert(OPS.name, par); OPS.Get(sym);
  233.       par^.mode := mode; par^.link := NIL;
  234.       IF first = NIL THEN first := par END ;
  235.       IF firstPar = NIL THEN firstPar := par ELSE last^.link := par END ;
  236.       last := par
  237.      ELSE err(ident)
  238.      END ;
  239.      IF sym = comma THEN OPS.Get(sym)
  240.      ELSIF sym = ident THEN err(comma)
  241.      ELSIF sym = var THEN err(comma); OPS.Get(sym)
  242.      ELSE EXIT
  243.      END
  244.     END ;
  245.     CheckSym(colon); Type(typ, OPT.notyp);
  246.     WHILE first # NIL DO first^.typ := typ; first := first^.link END ;
  247.     IF sym = semicolon THEN OPS.Get(sym)
  248.     ELSIF sym = ident THEN err(semicolon)
  249.     ELSE EXIT
  250.     END
  251.    END
  252.   END ;
  253.   CheckSym(rparen);
  254.   IF sym = colon THEN
  255.    OPS.Get(sym); resTyp := OPT.undftyp;
  256.    IF sym = ident THEN qualident(res);
  257.     IF res^.mode = Typ THEN
  258.      IF res^.typ^.form < Comp THEN resTyp := res^.typ
  259.      ELSE err(54)
  260.      END
  261.     ELSE err(52)
  262.     END
  263.    ELSE err(ident)
  264.    END
  265.   ELSE resTyp := OPT.notyp
  266.   END
  267.  END FormalParameters;
  268.  PROCEDURE TypeDecl(VAR typ, banned: OPT.Struct);
  269.   VAR id: OPT.Object;
  270.  BEGIN typ := OPT.undftyp;
  271.   IF sym < lparen THEN err(12);
  272.    REPEAT OPS.Get(sym) UNTIL sym >= lparen
  273.   END ;
  274.   IF sym = ident THEN qualident(id);
  275.    IF id^.mode = Typ THEN
  276.     IF id^.typ # banned THEN typ := id^.typ ELSE err(58) END
  277.    ELSE err(52)
  278.    END
  279.   ELSIF sym = array THEN
  280.    OPS.Get(sym); ArrayType(typ, banned)
  281.   ELSIF sym = record THEN
  282.    OPS.Get(sym); RecordType(typ, banned);
  283.    OPB.Inittd(TDinit, lastTDinit, typ); CheckSym(end)
  284.   ELSIF sym = pointer THEN
  285.    OPS.Get(sym); PointerType(typ)
  286.   ELSIF sym = procedure THEN
  287.    OPS.Get(sym); typ := OPT.NewStr(ProcTyp, Basic); CheckSysFlag(typ^.sysflag, 0);
  288.    IF sym = lparen THEN
  289.     OPS.Get(sym); OPT.OpenScope(level, NIL);
  290.     FormalParameters(typ^.link, typ^.BaseTyp); OPT.CloseScope
  291.    ELSE typ^.BaseTyp := OPT.notyp; typ^.link := NIL
  292.    END
  293.   ELSE err(12)
  294.   END ;
  295.   LOOP
  296.    IF (sym >= semicolon) & (sym <= else) OR (sym = rparen) OR (sym = eof) THEN EXIT END;
  297.    err(15); IF sym = ident THEN EXIT END;
  298.    OPS.Get(sym)
  299.   END
  300.  END TypeDecl;
  301.  PROCEDURE Type(VAR typ, banned: OPT.Struct);
  302.  BEGIN TypeDecl(typ, banned);
  303.   IF (typ^.form = Pointer) & (typ^.BaseTyp = OPT.undftyp) & (typ^.strobj = NIL) THEN err(0) END
  304.  END Type;
  305.  PROCEDURE selector(VAR x: OPT.Node);
  306.   VAR obj, proc: OPT.Object; y: OPT.Node; typ: OPT.Struct; name: OPS.Name;
  307.  BEGIN
  308.   LOOP
  309.    IF sym = lbrak THEN OPS.Get(sym);
  310.     LOOP
  311.      IF (x^.typ # NIL) & (x^.typ^.form = Pointer) THEN OPB.DeRef(x) END ;
  312.      Expression(y); OPB.Index(x, y);
  313.      IF sym = comma THEN OPS.Get(sym) ELSE EXIT END
  314.     END ;
  315.     CheckSym(rbrak)
  316.    ELSIF sym = period THEN OPS.Get(sym);
  317.     IF sym = ident THEN name := OPS.name; OPS.Get(sym);
  318.      IF x^.typ # NIL THEN
  319.       IF x^.typ^.form = Pointer THEN OPB.DeRef(x) END ;
  320.       IF x^.typ^.comp = Record THEN
  321.        OPT.FindField(name, x^.typ, obj); OPB.Field(x, obj);
  322.        IF (obj # NIL) & (obj^.mode = TProc) THEN
  323.         IF sym = arrow THEN  (* super call *) OPS.Get(sym);
  324.          y := x^.left;
  325.          IF y^.class = Nderef THEN y := y^.left END ; (* y = record variable *)
  326.          IF y^.obj # NIL THEN
  327.           proc := OPT.topScope; (* find innermost scope which owner is a TProc *)
  328.           WHILE (proc^.link # NIL) & (proc^.link^.mode # TProc) DO proc := proc^.left END ;
  329.           IF (proc^.link = NIL) OR (proc^.link^.link # y^.obj) THEN err(75) END ;
  330.           typ := y^.obj^.typ;
  331.           IF typ^.form = Pointer THEN typ := typ^.BaseTyp END ;
  332.           OPT.FindField(x^.obj^.name, typ^.BaseTyp, proc);
  333.           IF proc # NIL THEN x^.subcl := super ELSE err(74) END
  334.          ELSE err(75)
  335.          END
  336.         END ;
  337.         IF (obj^.typ # OPT.notyp) & (sym # lparen) THEN err(lparen) END
  338.        END
  339.       ELSE err(53)
  340.       END
  341.      ELSE err(52)
  342.      END
  343.     ELSE err(ident)
  344.     END
  345.    ELSIF sym = arrow THEN OPS.Get(sym); OPB.DeRef(x)
  346.    ELSIF (sym = lparen) & (x^.class < Nconst) & (x^.typ^.form # ProcTyp) &
  347.      ((x^.obj = NIL) OR (x^.obj^.mode # TProc)) THEN
  348.     OPS.Get(sym);
  349.     IF sym = ident THEN
  350.      qualident(obj);
  351.      IF obj^.mode = Typ THEN OPB.TypTest(x, obj, TRUE)
  352.      ELSE err(52)
  353.      END
  354.     ELSE err(ident)
  355.     END ;
  356.     CheckSym(rparen)
  357.    ELSE EXIT
  358.    END
  359.   END
  360.  END selector;
  361.  PROCEDURE ActualParameters(VAR aparlist: OPT.Node; fpar: OPT.Object);
  362.   VAR apar, last: OPT.Node;
  363.  BEGIN aparlist := NIL; last := NIL;
  364.   IF sym # rparen THEN
  365.    LOOP Expression(apar);
  366.     IF fpar # NIL THEN
  367.      OPB.Param(apar, fpar); OPB.Link(aparlist, last, apar);
  368.      fpar := fpar^.link;
  369.     ELSE err(64)
  370.     END ;
  371.     IF sym = comma THEN OPS.Get(sym)
  372.     ELSIF (lparen <= sym) & (sym <= ident) THEN err(comma)
  373.     ELSE EXIT
  374.     END
  375.    END
  376.   END ;
  377.   IF fpar # NIL THEN err(65) END
  378.  END ActualParameters;
  379.  PROCEDURE StandProcCall(VAR x: OPT.Node);
  380.   VAR y: OPT.Node; m: SHORTINT; n: INTEGER;
  381.  BEGIN m := SHORT(SHORT(x^.obj^.adr)); n := 0;
  382.   IF sym = lparen THEN OPS.Get(sym);
  383.    IF sym # rparen THEN
  384.     LOOP
  385.      IF n = 0 THEN Expression(x); OPB.StPar0(x, m); n := 1
  386.      ELSIF n = 1 THEN Expression(y); OPB.StPar1(x, y, m); n := 2
  387.      ELSE Expression(y); OPB.StParN(x, y, m, n); INC(n)
  388.      END ;
  389.      IF sym = comma THEN OPS.Get(sym)
  390.      ELSIF (lparen <= sym) & (sym <= ident) THEN err(comma)
  391.      ELSE EXIT
  392.      END
  393.     END ;
  394.     CheckSym(rparen)
  395.    ELSE OPS.Get(sym)
  396.    END ;
  397.    OPB.StFct(x, m, n)
  398.   ELSE err(lparen)
  399.   END ;
  400.   IF (level > 0) & ((m = newfn) OR (m = sysnewfn)) THEN OPT.topScope^.link^.leaf := FALSE END
  401.  END StandProcCall;
  402.  PROCEDURE Element(VAR x: OPT.Node);
  403.   VAR y: OPT.Node;
  404.  BEGIN Expression(x);
  405.   IF sym = upto THEN
  406.    OPS.Get(sym); Expression(y); OPB.SetRange(x, y)
  407.   ELSE OPB.SetElem(x)
  408.   END
  409.  END Element;
  410.  PROCEDURE Sets(VAR x: OPT.Node);
  411.   VAR y: OPT.Node;
  412.  BEGIN
  413.   IF sym # rbrace THEN
  414.    Element(x);
  415.    LOOP
  416.     IF sym = comma THEN OPS.Get(sym)
  417.     ELSIF (lparen <= sym) & (sym <= ident) THEN err(comma)
  418.     ELSE EXIT
  419.     END ;
  420.     Element(y); OPB.Op(plus, x, y)
  421.    END
  422.   ELSE x := OPB.EmptySet()
  423.   END ;
  424.   CheckSym(rbrace)
  425.  END Sets;
  426.  PROCEDURE Factor(VAR x: OPT.Node);
  427.   VAR fpar, id: OPT.Object; apar: OPT.Node;Dummy: LONGREAL;
  428.  BEGIN
  429.   IF sym < lparen THEN err(13);
  430.    REPEAT OPS.Get(sym) UNTIL sym >= lparen
  431.   END ;
  432.   IF sym = ident THEN
  433.    qualident(id); x := OPB.NewLeaf(id); selector(x);
  434.    IF (x^.class = Nproc) & (x^.obj^.mode = SProc) THEN StandProcCall(x) (* x may be NIL *)
  435.    ELSIF sym = lparen THEN
  436.     OPS.Get(sym); OPB.PrepCall(x, fpar);
  437.     ActualParameters(apar, fpar);
  438.     OPB.Call(x, apar, fpar);
  439.     CheckSym(rparen);
  440.     IF level > 0 THEN OPT.topScope^.link^.leaf := FALSE END
  441.    END
  442.   ELSIF sym = number THEN
  443.    CASE OPS.numtyp OF
  444.       char: x := OPB.NewIntConst(OPS.intval); x^.typ := OPT.chartyp
  445.    | integer: x := OPB.NewIntConst(OPS.intval)
  446.    | real:
  447.        AmigaMathL.Long(OPS.realval, Dummy);
  448.        x := OPB.NewRealConst(Dummy, OPT.realtyp)
  449. (*   | real: x := OPB.NewRealConst(OPS.realval, OPT.realtyp)*)
  450.    | longreal: x := OPB.NewRealConst(OPS.lrlval, OPT.lrltyp)
  451.    END ;
  452.    OPS.Get(sym)
  453.   ELSIF sym = string THEN
  454.    x := OPB.NewString(OPS.str, OPS.intval); OPS.Get(sym)
  455.   ELSIF sym = nil THEN
  456.    x := OPB.Nil(); OPS.Get(sym)
  457.   ELSIF sym = lparen THEN
  458.    OPS.Get(sym); Expression(x); CheckSym(rparen)
  459.   ELSIF sym = lbrak THEN
  460.    OPS.Get(sym); err(lparen); Expression(x); CheckSym(rparen)
  461.   ELSIF sym = lbrace THEN OPS.Get(sym); Sets(x)
  462.   ELSIF sym = not THEN
  463.    OPS.Get(sym); Factor(x); OPB.MOp(not, x)
  464.   ELSE err(13); OPS.Get(sym); x := NIL
  465.   END ;
  466.   IF x = NIL THEN x := OPB.NewIntConst(1); x^.typ := OPT.undftyp END
  467.  END Factor;
  468.  PROCEDURE Term(VAR x: OPT.Node);
  469.   VAR y: OPT.Node; mulop: SHORTINT;
  470.  BEGIN Factor(x);
  471.   WHILE (times <= sym) & (sym <= and) DO
  472.    mulop := sym; OPS.Get(sym);
  473.    Factor(y); OPB.Op(mulop, x, y)
  474.   END
  475.  END Term;
  476.  PROCEDURE SimpleExpression(VAR x: OPT.Node);
  477.   VAR y: OPT.Node; addop: SHORTINT;
  478.  BEGIN
  479.   IF sym = minus THEN OPS.Get(sym); Term(x); OPB.MOp(minus, x)
  480.   ELSIF sym = plus THEN OPS.Get(sym); Term(x); OPB.MOp(plus, x)
  481.   ELSE Term(x)
  482.   END ;
  483.   WHILE (plus <= sym) & (sym <= or) DO
  484.    addop := sym; OPS.Get(sym);
  485.    Term(y); OPB.Op(addop, x, y)
  486.   END
  487.  END SimpleExpression;
  488.  PROCEDURE Expression(VAR x: OPT.Node);
  489.   VAR y: OPT.Node; obj: OPT.Object; relation: SHORTINT;
  490.  BEGIN SimpleExpression(x);
  491.   IF (eql <= sym) & (sym <= geq) THEN
  492.    relation := sym; OPS.Get(sym);
  493.    SimpleExpression(y); OPB.Op(relation, x, y)
  494.   ELSIF sym = in THEN
  495.    OPS.Get(sym); SimpleExpression(y); OPB.In(x, y)
  496.   ELSIF sym = is THEN
  497.    OPS.Get(sym);
  498.    IF sym = ident THEN
  499.     qualident(obj);
  500.     IF obj^.mode = Typ THEN OPB.TypTest(x, obj, FALSE)
  501.     ELSE err(52)
  502.     END
  503.    ELSE err(ident)
  504.    END
  505.   END
  506.  END Expression;
  507.  PROCEDURE Receiver(VAR mode: SHORTINT; VAR name: OPS.Name; VAR typ, rec: OPT.Struct);
  508.   VAR obj: OPT.Object;
  509.  BEGIN typ := OPT.undftyp; rec := NIL;
  510.   IF sym = var THEN OPS.Get(sym); mode := VarPar ELSE mode := Var END ;
  511.   name := OPS.name; CheckSym(ident); CheckSym(colon);
  512.   IF sym = ident THEN OPT.Find(obj); OPS.Get(sym);
  513.    IF obj = NIL THEN err(0)
  514.    ELSIF obj^.mode # Typ THEN err(72)
  515.    ELSE typ := obj^.typ; rec := typ;
  516.     IF rec^.form = Pointer THEN rec := rec^.BaseTyp END ;
  517.     IF ~((mode = Var) & (typ^.form = Pointer) & (rec^.comp = Record) OR
  518.      (mode = VarPar) & (typ^.comp = Record)) THEN err(70); rec := NIL END ;
  519.     IF (rec # NIL) & (rec^.mno # level) THEN err(72); rec := NIL END
  520.    END
  521.   ELSE err(ident)
  522.   END ;
  523.   CheckSym(rparen);
  524.   IF rec = NIL THEN rec := OPT.NewStr(Comp, Record); rec^.BaseTyp := NIL END
  525.  END Receiver;
  526.  PROCEDURE Extends(x, b: OPT.Struct): BOOLEAN;
  527.  BEGIN
  528.   IF (b^.form = Pointer) & (x^.form = Pointer) THEN b := b^.BaseTyp; x := x^.BaseTyp END ;
  529.   IF (b^.comp = Record) & (x^.comp = Record) THEN
  530.    REPEAT x := x^.BaseTyp UNTIL (x = NIL) OR (x = b)
  531.   END ;
  532.   RETURN x = b
  533.  END Extends;
  534.  PROCEDURE ProcedureDeclaration(VAR x: OPT.Node);
  535.   VAR proc, fwd: OPT.Object;
  536.    name: OPS.Name;
  537.    mode, vis: SHORTINT;
  538.    forward: BOOLEAN;
  539.   PROCEDURE GetCode;
  540.    VAR ext: OPT.ConstExt; n: INTEGER; c: LONGINT;
  541.   BEGIN
  542.    ext := OPT.NewExt(); proc^.conval^.ext := ext; n := 0;
  543.    LOOP
  544.     IF sym = number THEN c := OPS.intval; INC(n);
  545.      IF (c < 0) OR (c > 255) OR (n = OPT.MaxConstLen) THEN
  546.       err(64); c := 1; n := 1
  547.      END ;
  548.      OPS.Get(sym); ext^[n] := CHR(c)
  549.     END ;
  550.     IF sym = comma THEN OPS.Get(sym)
  551.     ELSIF sym = number THEN err(comma)
  552.     ELSE ext^[0] := CHR(n); EXIT
  553.     END
  554.    END ;
  555.    INCL(proc^.conval^.setval, hasBody)
  556.   END GetCode;
  557.   PROCEDURE GetParams;
  558.   BEGIN
  559.    proc^.vis := vis; proc^.mode := mode; proc^.typ := OPT.notyp;
  560.    proc^.conval := OPT.NewConst(); proc^.conval^.setval := {};
  561.    IF sym = lparen THEN
  562.     OPS.Get(sym); FormalParameters(proc^.link, proc^.typ)
  563.    END ;
  564.    IF fwd # NIL THEN
  565.     OPB.CheckParameters(proc^.link, fwd^.link, TRUE);
  566.     IF proc^.typ # fwd^.typ THEN err(117) END ;
  567.     proc := fwd; OPT.topScope := fwd^.scope
  568.    END
  569.   END GetParams;
  570.   PROCEDURE Body;
  571.    VAR procdec, statseq: OPT.Node; c: LONGINT;
  572.   BEGIN
  573.    c := OPM.errpos;
  574.    INCL(proc^.conval^.setval, hasBody);
  575.    CheckSym(semicolon); Block(procdec, statseq);
  576.    OPB.Enter(procdec, statseq, proc); x := procdec;
  577.    x^.conval := OPT.NewConst(); x^.conval^.intval := c;
  578.    IF sym = ident THEN
  579.     IF OPS.name # proc^.name THEN err(4) END ;
  580.     OPS.Get(sym)
  581.    ELSE err(ident)
  582.    END
  583.   END Body;
  584.   PROCEDURE TProcDecl;
  585.    VAR baseProc: OPT.Object;
  586.     objTyp, recTyp: OPT.Struct;
  587.     objMode: SHORTINT;
  588.     objName: OPS.Name;
  589.   BEGIN
  590.    OPS.Get(sym); mode := TProc;
  591.    IF level > 0 THEN err(73) END ;
  592.    Receiver(objMode, objName, objTyp, recTyp);
  593.    IF sym = ident THEN
  594.     name := OPS.name; CheckMark(vis);
  595.     OPT.FindField(name, recTyp, fwd);
  596.     OPT.FindField(name, recTyp^.BaseTyp, baseProc);
  597.     IF (baseProc # NIL) & (baseProc^.mode # TProc) THEN baseProc := NIL END ;
  598.     IF fwd = baseProc THEN fwd := NIL END ;
  599.     IF (fwd # NIL) & (fwd^.mnolev # level) THEN fwd := NIL END ;
  600.     IF (fwd # NIL) & (fwd^.mode = TProc) & ~(hasBody IN fwd^.conval^.setval) THEN
  601.      (* there exists a corresponding forward declaration *)
  602.      proc := OPT.NewObj(); proc^.leaf := TRUE;
  603.      IF fwd^.vis # vis THEN err(118) END
  604.     ELSE
  605.      IF fwd # NIL THEN err(1); fwd := NIL END ;
  606.      OPT.OpenScope(0, NIL); OPT.topScope^.right := recTyp^.link; OPT.Insert(name, proc);
  607.      recTyp^.link := OPT.topScope^.right; OPT.CloseScope; 
  608.     END ;
  609.     INC(level); OPT.OpenScope(level, proc);
  610.     OPT.Insert(objName, proc^.link); proc^.link^.mode := objMode; proc^.link^.typ := objTyp;
  611.     GetParams;
  612.     IF baseProc # NIL THEN
  613.      IF (objMode # baseProc^.link^.mode) OR ~Extends(objTyp, baseProc^.link^.typ) THEN err(115) END ;
  614.      OPB.CheckParameters(proc^.link^.link, baseProc^.link^.link, FALSE);
  615.      IF proc^.typ # baseProc^.typ THEN err(117) END ;
  616.      IF (baseProc^.vis = external) & (proc^.vis = internal) &
  617.       (recTyp^.strobj # NIL) & (recTyp^.strobj^.vis = external) THEN err(109)
  618.      END ;
  619.      INCL(proc^.conval^.setval, isRedef)
  620.     END ;
  621.     IF ~forward THEN Body END ;
  622.     DEC(level); OPT.CloseScope
  623.    ELSE err(ident)
  624.    END
  625.   END TProcDecl;
  626.  BEGIN proc := NIL; forward := FALSE; x := NIL; mode := LProc;
  627.   IF (sym # ident) & (sym # lparen) THEN
  628.    IF sym = times THEN (* mode set later in OPB.CheckAssign *)
  629.    ELSIF sym = arrow THEN forward := TRUE
  630.    ELSIF sym = plus THEN mode := IProc
  631.    ELSIF sym = minus THEN mode := CProc
  632.    ELSE err(ident)
  633.    END ;
  634.    IF (mode IN {IProc, CProc}) & ~OPT.SYSimported THEN err(135) END ;
  635.    OPS.Get(sym)
  636.   END ;
  637.   IF sym = lparen THEN TProcDecl
  638.   ELSIF sym = ident THEN OPT.Find(fwd);
  639.    name := OPS.name; CheckMark(vis);
  640.    IF (vis # internal) & (mode = LProc) THEN mode := XProc END ;
  641.    IF (fwd # NIL) & ((fwd^.mnolev # level) OR (fwd^.mode = SProc)) THEN fwd := NIL END ;
  642.    IF (fwd # NIL) & (fwd^.mode IN {LProc, XProc}) & ~(hasBody IN fwd^.conval^.setval) THEN
  643.     (* there exists a corresponding forward declaration *)
  644.     proc := OPT.NewObj(); proc^.leaf := TRUE;
  645.     IF fwd^.vis # vis THEN err(118) END
  646.    ELSE
  647.     IF fwd # NIL THEN err(1); fwd := NIL END ;
  648.     OPT.Insert(name, proc)
  649.    END ;
  650.    IF (mode # LProc) & (level > 0) THEN err(73) END ;
  651.    INC(level); OPT.OpenScope(level, proc);
  652.    proc^.link := NIL; GetParams;
  653.    IF mode = CProc THEN GetCode
  654.    ELSIF ~forward THEN Body
  655.    END ;
  656.    DEC(level); OPT.CloseScope
  657.   ELSE err(ident)
  658.   END
  659.  END ProcedureDeclaration;
  660.  PROCEDURE CaseLabelList(VAR lab: OPT.Node; LabelForm: INTEGER; VAR n: INTEGER; VAR tab: CaseTable);
  661.   VAR x, y, lastlab: OPT.Node; i, f: INTEGER; xval, yval: LONGINT;
  662.  BEGIN lab := NIL; lastlab := NIL;
  663.   LOOP ConstExpression(x); f := x^.typ^.form;
  664.    IF f IN intSet + {Char} THEN  xval := x^.conval^.intval
  665.    ELSE err(61); xval := 1
  666.    END ;
  667.    IF f IN intSet THEN
  668.     IF LabelForm < f THEN err(60) END
  669.    ELSIF LabelForm # f THEN err(60)
  670.    END ;
  671.    IF sym = upto THEN
  672.     OPS.Get(sym); ConstExpression(y); yval := y^.conval^.intval;
  673.     IF (y^.typ^.form # f) & ~((f IN intSet) & (y^.typ^.form IN intSet)) THEN err(60) END ;
  674.     IF yval < xval THEN err(63); yval := xval END
  675.    ELSE yval := xval
  676.    END ;
  677.    x^.conval^.intval2 := yval;
  678.    (*enter label range into ordered table*)  i := n;
  679.    IF i < OPM.MaxCases THEN
  680.     LOOP
  681.      IF i = 0 THEN EXIT END ;
  682.      IF tab[i-1].low <= yval THEN
  683.       IF tab[i-1].high >= xval THEN err(62) END ;
  684.       EXIT
  685.      END ;
  686.      tab[i] := tab[i-1]; DEC(i)
  687.     END ;
  688.     tab[i].low := xval; tab[i].high := yval; INC(n)
  689.    ELSE err(213)
  690.    END ;
  691.    OPB.Link(lab, lastlab, x);
  692.    IF sym = comma THEN OPS.Get(sym)
  693.    ELSIF (sym = number) OR (sym = ident) THEN err(comma)
  694.    ELSE EXIT
  695.    END
  696.   END
  697.  END CaseLabelList;
  698.  PROCEDURE StatSeq(VAR stat: OPT.Node);
  699.   VAR fpar, id, t, obj: OPT.Object; idtyp: OPT.Struct; e: BOOLEAN;
  700.     s, x, y, z, apar, last, lastif: OPT.Node; pos: LONGINT;
  701.   PROCEDURE CasePart(VAR x: OPT.Node);
  702.    VAR n: INTEGER; low, high: LONGINT; e: BOOLEAN;
  703.      tab: CaseTable; cases, lab, y, lastcase: OPT.Node; 
  704.   BEGIN
  705.    Expression(x); pos := OPM.errpos;
  706.    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
  707.    ELSIF ~(x^.typ^.form IN {Char..LInt}) THEN err(125)
  708.    END ;
  709.    CheckSym(of); cases := NIL; lastcase := NIL; n := 0;
  710.    LOOP
  711.     IF sym < bar THEN
  712.      CaseLabelList(lab, x^.typ^.form, n, tab);
  713.      CheckSym(colon); StatSeq(y);
  714.      OPB.Construct(Ncasedo, lab, y); OPB.Link(cases, lastcase, lab)
  715.     END ;
  716.     IF sym = bar THEN OPS.Get(sym) ELSE EXIT END
  717.    END ;
  718.    IF n > 0 THEN low := tab[0].low; high := tab[n-1].high;
  719.     IF high - low > OPM.MaxCaseRange THEN err(209) END
  720.    ELSE low := 1; high := 0
  721.    END ;
  722.    e := sym = else;
  723.    IF e THEN OPS.Get(sym); StatSeq(y) ELSE y := NIL END ;
  724.    OPB.Construct(Ncaselse, cases, y); OPB.Construct(Ncase, x, cases);
  725.    cases^.conval := OPT.NewConst();
  726.    cases^.conval^.intval := low; cases^.conval^.intval2 := high;
  727.    IF e THEN cases^.conval^.setval := {1} ELSE cases^.conval^.setval := {} END
  728.   END CasePart;
  729.   PROCEDURE SetPos(x: OPT.Node);
  730.   BEGIN
  731.    x^.conval := OPT.NewConst(); x^.conval^.intval := pos
  732.   END SetPos;
  733.   PROCEDURE CheckBool(VAR x: OPT.Node);
  734.   BEGIN
  735.    IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126); x := OPB.NewBoolConst(FALSE)
  736.    ELSIF x^.typ^.form # Bool THEN err(120); x := OPB.NewBoolConst(FALSE)
  737.    END ;
  738.    pos := OPM.errpos
  739.   END CheckBool;
  740.  BEGIN stat := NIL; last := NIL;
  741.   LOOP x := NIL;
  742.    IF sym < ident THEN err(14);
  743.     REPEAT OPS.Get(sym) UNTIL sym >= ident
  744.    END ;
  745.    IF sym = ident THEN
  746.     qualident(id); x := OPB.NewLeaf(id); selector(x);
  747.     IF sym = becomes THEN
  748.      OPS.Get(sym); Expression(y); OPB.Assign(x, y)
  749.     ELSIF sym = eql THEN
  750.      err(becomes); OPS.Get(sym); Expression(y); OPB.Assign(x, y)
  751.     ELSIF (x^.class = Nproc) & (x^.obj^.mode = SProc) THEN
  752.      StandProcCall(x);
  753.      IF (x # NIL) & (x^.typ # OPT.notyp) THEN err(55) END
  754.     ELSE OPB.PrepCall(x, fpar);
  755.      IF sym = lparen THEN
  756.       OPS.Get(sym); ActualParameters(apar, fpar); CheckSym(rparen)
  757.      ELSE apar := NIL;
  758.       IF fpar # NIL THEN err(65) END
  759.      END ;
  760.      OPB.Call(x, apar, fpar);
  761.      IF x^.typ # OPT.notyp THEN err(55) END ;
  762.      IF level > 0 THEN OPT.topScope^.link^.leaf := FALSE END
  763.     END ;
  764.     pos := OPM.errpos
  765.    ELSIF sym = if THEN
  766.     OPS.Get(sym); Expression(x); CheckBool(x); CheckSym(then); StatSeq(y);
  767.     OPB.Construct(Nif, x, y); SetPos(x); lastif := x;
  768.     WHILE sym = elsif DO
  769.      OPS.Get(sym); Expression(y); CheckBool(y); CheckSym(then); StatSeq(z);
  770.      OPB.Construct(Nif, y, z); SetPos(y); OPB.Link(x, lastif, y);
  771.     END ;
  772.     IF sym = else THEN OPS.Get(sym); StatSeq(y)
  773.     ELSE y := NIL
  774.     END ;
  775.     OPB.Construct(Nifelse, x, y); CheckSym(end); OPB.OptIf(x); pos := OPM.errpos
  776.    ELSIF sym = case THEN
  777.     OPS.Get(sym); CasePart(x); CheckSym(end)
  778.    ELSIF sym = while THEN
  779.     OPS.Get(sym); Expression(x); CheckBool(x); CheckSym(do); StatSeq(y);
  780.     OPB.Construct(Nwhile, x, y); CheckSym(end)
  781.    ELSIF sym = repeat THEN
  782.     OPS.Get(sym); StatSeq(x);
  783.     IF sym = until THEN OPS.Get(sym); Expression(y); CheckBool(y)
  784.     ELSE err(until)
  785.     END ;
  786.     OPB.Construct(Nrepeat, x, y)
  787.    ELSIF sym = for THEN
  788.     OPS.Get(sym);
  789.     IF sym = ident THEN qualident(id);
  790.      IF ~(id^.typ^.form IN intSet) THEN err(68) END ;
  791.      CheckSym(becomes); Expression(y); pos := OPM.errpos;
  792.      x := OPB.NewLeaf(id); OPB.Assign(x, y); SetPos(x); OPB.Link(stat, last, x);
  793.      CheckSym(to); Expression(y); pos := OPM.errpos;
  794.      IF y^.class # Nconst THEN
  795.       OPT.Insert("@@", t); t^.name := "@for"; t^.mode := Var; t^.typ := y.typ;
  796.       obj := OPT.topScope^.scope;
  797.       IF obj = NIL THEN OPT.topScope^.scope := t
  798.       ELSE
  799.        WHILE obj^.link # NIL DO obj := obj^.link END ;
  800.        obj^.link := t
  801.       END ;
  802.       x := OPB.NewLeaf(t); OPB.Assign(x, y); SetPos(x); OPB.Link(stat, last, x);
  803.       y := OPB.NewLeaf(t)
  804.      END ;
  805.      IF sym = by THEN OPS.Get(sym); ConstExpression(z) ELSE z := OPB.NewIntConst(1) END ;
  806.      pos := OPM.errpos; x := OPB.NewLeaf(id);
  807.      IF z^.conval^.intval > 0 THEN OPB.Op(leq, x, y)
  808.      ELSIF z^.conval^.intval < 0 THEN OPB.Op(geq, x, y)
  809.      ELSE err(63); OPB.Op(geq, x, y)
  810.      END ;
  811.      CheckSym(do); StatSeq(s);
  812.      y := OPB.NewLeaf(id); OPB.StPar1(y, z, incfn); SetPos(y);
  813.      IF s = NIL THEN s := y
  814.      ELSE z := s;
  815.       WHILE z^.link # NIL DO z := z^.link END ;
  816.       z^.link := y
  817.      END ;
  818.      CheckSym(end); OPB.Construct(Nwhile, x, s)
  819.     ELSE err(ident)
  820.     END
  821.    ELSIF sym = loop THEN
  822.     OPS.Get(sym); INC(LoopLevel); StatSeq(x); DEC(LoopLevel);
  823.     OPB.Construct(Nloop, x, NIL); CheckSym(end); pos := OPM.errpos
  824.    ELSIF sym = with THEN
  825.     OPS.Get(sym); idtyp := NIL; x := NIL;
  826.     LOOP
  827.      IF sym = ident THEN
  828.       qualident(id); y := OPB.NewLeaf(id); CheckSym(colon);
  829.       IF sym = ident THEN qualident(t);
  830.        IF t^.mode = Typ THEN
  831.         IF id # NIL THEN
  832.          idtyp := id^.typ; OPB.TypTest(y, t, FALSE); id^.typ := t^.typ
  833.         ELSE err(130)
  834.         END
  835.        ELSE err(52)
  836.        END
  837.       ELSE err(ident)
  838.       END
  839.      ELSE err(ident)
  840.      END ;
  841.      pos := OPM.errpos; CheckSym(do); StatSeq(s); OPB.Construct(Nif, y, s); SetPos(y);
  842.      IF idtyp # NIL THEN
  843.       IF (idtyp^.form = Pointer) & ~id^.leaf THEN err(-302) END ; (* warning 302 *)
  844.       id^.typ := idtyp; idtyp := NIL
  845.      END ;
  846.      IF x = NIL THEN x := y; lastif := x ELSE OPB.Link(x, lastif, y) END ;
  847.      IF sym = bar THEN OPS.Get(sym) ELSE EXIT END
  848.     END;
  849.     e := sym = else;
  850.     IF e THEN OPS.Get(sym); StatSeq(s) ELSE s := NIL END ;
  851.     OPB.Construct(Nwith, x, s); CheckSym(end);
  852.     IF e THEN x^.subcl := 1 END
  853.    ELSIF sym = exit THEN
  854.     OPS.Get(sym);
  855.     IF LoopLevel = 0 THEN err(46) END ;
  856.     OPB.Construct(Nexit, x, NIL);
  857.     pos := OPM.errpos
  858.    ELSIF sym = return THEN OPS.Get(sym);
  859.     IF sym < semicolon THEN Expression(x) END ;
  860.     IF level > 0 THEN OPB.Return(x, OPT.topScope^.link)
  861.     ELSE (* not standard Oberon *) OPB.Return(x, NIL)
  862.     END ;
  863.     pos := OPM.errpos
  864.    END ;
  865.    IF x # NIL THEN SetPos(x); OPB.Link(stat, last, x) END ;
  866.    IF sym = semicolon THEN OPS.Get(sym)
  867.    ELSIF (sym <= ident) OR (if <= sym) & (sym <= return) THEN err(semicolon)
  868.    ELSE EXIT
  869.    END
  870.   END
  871.  END StatSeq;
  872.  PROCEDURE Block(VAR procdec, statseq: OPT.Node);
  873.   VAR typ: OPT.Struct;
  874.    obj, first, last: OPT.Object;
  875.    x, lastdec: OPT.Node;
  876.    name: OPS.Name;
  877.    vis: SHORTINT; i: INTEGER;
  878.  BEGIN first := NIL; last := NIL; nofFwdPtr := 0;
  879.   LOOP
  880.    IF sym = const THEN
  881.     OPS.Get(sym);
  882.     WHILE sym = ident DO
  883.      COPY(OPS.name, name); CheckMark(vis);
  884.      IF sym = eql THEN
  885.       OPS.Get(sym); ConstExpression(x)
  886.      ELSIF sym = becomes THEN
  887.       err(eql); OPS.Get(sym); ConstExpression(x)
  888.      ELSE err(eql); x := OPB.NewIntConst(1)
  889.      END ;
  890.      OPT.Insert(name, obj); obj^.mode := Con;
  891.      obj^.typ := x^.typ; obj^.conval := x^.conval; obj^.vis := vis; (* ConstDesc ist not copied *)
  892.      CheckSym(semicolon)
  893.     END
  894.    END ;
  895.    IF sym = type THEN
  896.     OPS.Get(sym);
  897.     WHILE sym = ident DO
  898.      OPT.Insert(OPS.name, obj); obj^.mode := Typ; obj^.typ := OPT.undftyp;
  899.      CheckMark(obj^.vis);
  900.      IF sym = eql THEN
  901.       OPS.Get(sym); TypeDecl(obj^.typ, obj^.typ)
  902.      ELSIF (sym = becomes) OR (sym = colon) THEN
  903.       err(eql); OPS.Get(sym); TypeDecl(obj^.typ, obj^.typ)
  904.      ELSE err(eql)
  905.      END ;
  906.      IF obj^.typ^.strobj = NIL THEN obj^.typ^.strobj := obj END ;
  907.      IF obj^.typ^.comp IN {Record, Array, DynArr} THEN
  908.       i := 0;
  909.       WHILE i < nofFwdPtr DO typ := FwdPtr[i]; INC(i);
  910.        IF typ^.link^.name = obj^.name THEN typ^.BaseTyp := obj^.typ; typ^.link^.name := "" END
  911.       END
  912.      END ;
  913.      CheckSym(semicolon)
  914.     END
  915.    END ;
  916.    IF sym = var THEN
  917.     OPS.Get(sym);
  918.     WHILE sym = ident DO
  919.      LOOP
  920.       IF sym = ident THEN
  921.        OPT.Insert(OPS.name, obj); CheckMark(obj^.vis);
  922.        obj^.mode := Var; obj^.link := NIL; obj^.leaf := obj^.vis = internal;
  923.        IF first = NIL THEN first := obj END ;
  924.        IF last = NIL THEN OPT.topScope^.scope := obj ELSE last^.link := obj END ;
  925.        last := obj
  926.       ELSE err(ident)
  927.       END ;
  928.       IF sym = comma THEN OPS.Get(sym)
  929.       ELSIF sym = ident THEN err(comma)
  930.       ELSE EXIT
  931.       END
  932.      END ;
  933.      CheckSym(colon); Type(typ, OPT.notyp);
  934.      IF typ^.comp = DynArr THEN typ := OPT.undftyp; err(88) END ;
  935.      WHILE first # NIL DO first^.typ := typ; first := first^.link END ;
  936.      CheckSym(semicolon)
  937.     END
  938.    END ;
  939.    IF (sym < const) OR (sym > var) THEN EXIT END ;
  940.   END ;
  941.   i := 0;
  942.   WHILE i < nofFwdPtr DO
  943.    IF FwdPtr[i]^.link^.name # "" THEN err(128) END ;
  944.    FwdPtr[i] := NIL; (* garbage collection *)
  945.    INC(i)
  946.   END ;
  947.   OPT.topScope^.adr := OPM.errpos;
  948.   procdec := NIL; lastdec := NIL;
  949.   WHILE sym = procedure DO
  950.    OPS.Get(sym); ProcedureDeclaration(x);
  951.    IF x # NIL THEN
  952.     IF lastdec = NIL THEN procdec := x ELSE lastdec^.link := x END ;
  953.     lastdec := x
  954.    END ;
  955.    CheckSym(semicolon)
  956.   END ;
  957.   IF sym = begin THEN OPS.Get(sym); StatSeq(statseq)
  958.   ELSE statseq := NIL
  959.   END ;
  960.   IF (level = 0) & (TDinit # NIL) THEN
  961.    lastTDinit^.link := statseq; statseq := TDinit
  962.   END ;
  963.   CheckSym(end)
  964.  END Block;
  965.  PROCEDURE Module*(VAR prog: OPT.Node; VAR modName: OPS.Name);
  966.   VAR impName, aliasName: OPS.Name;
  967.     procdec, statseq: OPT.Node;
  968.     c: LONGINT;
  969.  BEGIN 
  970.   LoopLevel := 0; level := 0;
  971.   OPS.Get(sym);
  972.   IF sym = module THEN OPS.Get(sym) ELSE err(16) END ;
  973.   IF sym = ident THEN
  974.    COPY(OPS.name, modName); OPS.Get(sym); CheckSym(semicolon);
  975.    IF sym = import THEN OPS.Get(sym);
  976.     LOOP
  977.      IF sym = ident THEN
  978.       COPY(OPS.name, aliasName); COPY(aliasName, impName); OPS.Get(sym);
  979.       IF sym = becomes THEN OPS.Get(sym);
  980.        IF sym = ident THEN COPY(OPS.name, impName); OPS.Get(sym) ELSE err(ident) END
  981.       END ;
  982.       OPT.Import(aliasName, impName, modName)
  983.      ELSE err(ident)
  984.      END ;
  985.      IF sym = comma THEN OPS.Get(sym)
  986.      ELSIF sym = ident THEN err(comma)
  987.      ELSE EXIT
  988.      END
  989.     END ;
  990.     CheckSym(semicolon)
  991.    END ;
  992.    IF OPM.noerr THEN TDinit := NIL; lastTDinit := NIL; c := OPM.errpos;
  993.     Block(procdec, statseq); OPB.Enter(procdec, statseq, NIL); prog := procdec;
  994.     prog^.conval := OPT.NewConst(); prog^.conval^.intval := c;
  995.     IF sym = ident THEN
  996.      IF OPS.name # modName THEN err(4) END ;
  997.      OPS.Get(sym)
  998.     ELSE err(ident)
  999.     END ;
  1000.     IF sym # period THEN err(period) END
  1001.    END
  1002.   ELSE err(ident)
  1003.   END ;
  1004.   TDinit := NIL; lastTDinit := NIL
  1005.  END Module;
  1006. END OPP.
  1007.